﻿{*******************************************************************************
  Copyright 2016-2020 Daniele Spinetti

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
  ********************************************************************************}

unit uNiuEventBus.Core;

interface

uses
  uNiuEventBus;

type
  TNiuEventBusFactory = class
  strict private
    class var FEventBus : INiuEventBus;
    class var FBusOwner : Boolean;

    class constructor Create;
    class destructor Destroy;
    class function CreateEventBus: INiuEventBus;
  public
    class function GetInstance: INiuEventBus;
  end;

implementation
uses
  System.Classes,
  System.Generics.Collections,
  System.Rtti,
  System.SysUtils,
  {$IF CompilerVersion >= 28.0}
  System.Threading,
  {$ENDIF}
  uNiuCommon,
  uNiuEventBus.SubscriberContainer,
  uNiuEventBus.Helpers,
  uNiuEventBus.Subscribers;

type

  TNiuEventBus = class(TInterfacedObject, INiuEventBus)
  strict private
    FSubscriberContainer:ISubscriberContainer;
    FDebThreadPool: TThreadPool;

    procedure InvokeSubscriber(ASubscription: IDEBSubscription; const Args: array of TValue);
    function IsRegistered<T: TSubscriberMethodAttribute>(ASubscriber: TObject): Boolean;
    procedure RegisterSubscriberByType<T: TSubscriberMethodAttribute>(ASubscriber: TObject; ARaiseExcIfEmpty: Boolean);
    procedure Subscribe<T: TSubscriberMethodAttribute>(ASubscriber: TObject; ASubscriberMethod: TSubscriberMethod);
    procedure UnregisterSubscriberByType<T: TSubscriberMethodAttribute>(ASubscriber: TObject); overload;
    procedure Unsubscribe<T: TSubscriberMethodAttribute>(ASubscriber: TObject; const AMethodCategory: String);

    function RemoveSubscription<T: TSubscriberMethodAttribute>(ASubscriber: TObject; const ACategory: String): IDEBSubscription;
  protected
    function IsRegisteredForChannels(ASubscriber: TObject): Boolean;
    function IsRegisteredForEvents(ASubscriber: TObject): Boolean;
    procedure RegisterSubscriberForChannels(ASubscriber: TObject);
    procedure RegisterSubscriberForEvents(ASubscriber: TObject);
    procedure SilentRegisterSubscriberForChannels(ASubscriber: TObject);
    procedure SilentRegisterSubscriberForEvents(ASubscriber: TObject);
    procedure UnregisterForChannels(ASubscriber: TObject);
    procedure UnregisterForEvents(ASubscriber: TObject);
    procedure PostToChannel(ASubscription: IDEBSubscription; const aParams:IParameters; AIsMainThread: Boolean); virtual;
    procedure PostToSubscription(ASubscription: IDEBSubscription; const AEvent: IInterface; AIsMainThread: Boolean); virtual;

    property SubscriberContainer:ISubscriberContainer read FSubscriberContainer;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    {$REGION'INiuEventBus interface methods'}
    procedure RegisterSubscriber(ASubscriber: TObject; ARaiseExcIfEmpty: Boolean=False);  stdcall;
    procedure UnregisterSubscriber(ASubscriber: TObject); overload; stdcall;

    function IsRegisteredSubscriber(ASubscriber: TObject): Boolean; stdcall;

    procedure Post(const AChannel: string; const aParams:IParameters); overload;  stdcall;
    procedure Post(const AEvent: IInterface; const AContext: string = ''); overload;  stdcall;
    {$ENDREGION}
  end;


constructor TNiuEventBus.Create;
begin
  inherited Create;

  FSubscriberContainer := GloablSubscriberContainer();
  FDebThreadPool := TThreadPool.Create;
end;

destructor TNiuEventBus.Destroy;
begin
  FDebThreadPool.Free;

  if assigned(FSubscriberContainer) then
  try
     DestroySubscriberContainer(FSubscriberContainer);
  finally
     FSubscriberContainer := nil;
  end;

  inherited;
end;


procedure TNiuEventBus.RegisterSubscriberByType<T>(ASubscriber: TObject; ARaiseExcIfEmpty: Boolean);
begin
  var LSubscriberMethods := TList<TSubscriberMethod>.Create;
  try
    var LSubscriberClass := ASubscriber.ClassType;
    TSubscribersFinder.FindSubscriberMethods<T>(LSubscriberClass, LSubscriberMethods);

    if LSubscriberMethods.Count=0 then begin
       if ARaiseExcIfEmpty then begin
         raise EObjectHasNoSubscriberMethods.CreateFmt('%s Has No Subscriber Method', [ASubscriber.ClassName]);
       end;

       Exit;
    end;

    SubscriberContainer.Subscribe(HashCode(T.ClassName), ASubscriber, LSubscriberMethods);
  finally
    LSubscriberMethods.Free;
  end;
end;

procedure TNiuEventBus.RegisterSubscriberForChannels(ASubscriber: TObject);
begin
  RegisterSubscriberByType<ChannelAttribute>(ASubscriber, True);
end;

procedure TNiuEventBus.RegisterSubscriberForEvents(ASubscriber: TObject);
begin
  RegisterSubscriberByType<SubscribeAttribute>(ASubscriber, True);
end;

procedure TNiuEventBus.SilentRegisterSubscriberForChannels(ASubscriber: TObject);
begin
  RegisterSubscriberByType<ChannelAttribute>(ASubscriber, False);
end;

procedure TNiuEventBus.SilentRegisterSubscriberForEvents(ASubscriber: TObject);
begin
  RegisterSubscriberByType<SubscribeAttribute>(ASubscriber, False);
end;

procedure TNiuEventBus.RegisterSubscriber(ASubscriber: TObject; ARaiseExcIfEmpty: Boolean);
begin
  RegisterSubscriberByType<ChannelAttribute>(ASubscriber, ARaiseExcIfEmpty);
  RegisterSubscriberByType<SubscribeAttribute>(ASubscriber, ARaiseExcIfEmpty);
end;

function TNiuEventBus.IsRegistered<T>(ASubscriber: TObject): Boolean;
begin
  Result := SubscriberContainer.IsRegistered(HashCode(T.ClassName), ASubscriber);
end;

function TNiuEventBus.IsRegisteredForChannels(ASubscriber: TObject): Boolean;
begin
  Result := IsRegistered<ChannelAttribute>(ASubscriber);
end;

function TNiuEventBus.IsRegisteredForEvents(ASubscriber: TObject): Boolean;
begin
  Result := IsRegistered<SubscribeAttribute>(ASubscriber);
end;

function TNiuEventBus.IsRegisteredSubscriber(ASubscriber: TObject): Boolean;
begin
   Result := IsRegistered<ChannelAttribute>(ASubscriber)
          or IsRegistered<SubscribeAttribute>(ASubscriber);
end;

procedure TNiuEventBus.Subscribe<T>(ASubscriber: TObject; ASubscriberMethod: TSubscriberMethod);
begin
  SubscriberContainer.Subscribe(HashCode(T.ClassName), ASubscriber, ASubscriberMethod);
end;

procedure TNiuEventBus.UnregisterSubscriberByType<T>(ASubscriber: TObject);
begin
  SubscriberContainer.Unsubscribe(HashCode(T.ClassName), ASubscriber);
end;

procedure TNiuEventBus.UnregisterForChannels(ASubscriber: TObject);
begin
  UnregisterSubscriberByType<ChannelAttribute>(ASubscriber);
end;

procedure TNiuEventBus.UnregisterForEvents(ASubscriber: TObject);
begin
  UnregisterSubscriberByType<SubscribeAttribute>(ASubscriber);
end;

procedure TNiuEventBus.UnregisterSubscriber(ASubscriber: TObject);
begin
  UnregisterSubscriberByType<SubscribeAttribute>(ASubscriber);
  UnregisterSubscriberByType<ChannelAttribute>(ASubscriber);
end;

procedure TNiuEventBus.Unsubscribe<T>(ASubscriber: TObject; const AMethodCategory: String);
begin
  SubscriberContainer.Unsubscribe(HashCode(T.ClassName), ASubscriber, HashCode(AMethodCategory));
end;

function TNiuEventBus.RemoveSubscription<T>(ASubscriber: TObject; const ACategory: String): IDEBSubscription;
begin
  Result := SubscriberContainer.RemoveSubscription(HashCode(T.ClassName), ASubscriber, HashCode(ACategory));
end;

procedure TNiuEventBus.InvokeSubscriber(ASubscription: IDEBSubscription; const Args: array of TValue);
const
  _ERR_MSG = 'Error invoking subscriber method. Subscriber class: %s. Category: %s. Original exception %s: %s.';
begin
  try
    if not ASubscription.Active then
       Exit;

    if not Assigned( ASubscription.Subscriber) then
       Exit;

    ASubscription.SubscriberMethod.Method.Invoke(ASubscription.Subscriber, Args);
  except
    on E: Exception do begin
      raise EInvokeSubscriberError.CreateFmt(_ERR_MSG,
            [
              ASubscription.Subscriber.ClassName,
              ASubscription.SubscriberMethod.Category,
              // ASubscription.SubscriberMethod.EventType,
              E.ClassName,
              E.Message
            ]);
    end;
  end;
end;

procedure TNiuEventBus.Post(const AChannel: string; const aParams:IParameters);
begin
  var LEventType:= TInterfaceHelper.GetQualifiedName(aParams);
  var mCategory := TSubscriberMethod.EncodeCategory(AChannel, LEventType);

  var LIsMainThread := (MainThreadID = TThread.CurrentThread.ThreadID);

  SubscriberContainer.forEach(HashCode(ChannelAttribute.ClassName), HashCode(mCategory),
      procedure(aSubscription:IDEBSubscription)
      begin
        if (aSubscription.Context <> AChannel)  then Exit;
        PostToChannel(aSubscription, aParams, LIsMainThread);
      end);
end;

procedure TNiuEventBus.Post(const AEvent: IInterface; const AContext: string = '');
begin

  var LEventType:= TInterfaceHelper.GetQualifiedName(AEvent);
  var mCategory := TSubscriberMethod.EncodeCategory(AContext, LEventType);

  var LIsMainThread := (MainThreadID = TThread.CurrentThread.ThreadID);

  SubscriberContainer.forEach(HashCode(SubscribeAttribute.ClassName), HashCode(mCategory),
      procedure(aSubscription:IDEBSubscription)
      begin
        PostToSubscription(aSubscription, AEvent, LIsMainThread);
      end);
end;

procedure TNiuEventBus.PostToChannel(ASubscription: IDEBSubscription; const aParams:IParameters; AIsMainThread: Boolean);
var
  LProc: TProc;
begin
  if not Assigned(ASubscription.Subscriber) then
    Exit;

  LProc := procedure begin
    InvokeSubscriber(ASubscription, [aParams as TObject]);
  end;

  case ASubscription.SubscriberMethod.ThreadMode of
    tmPosting:
      LProc();
    tmMainThread:
      if (AIsMainThread) then
        LProc()
      else
        TThread.Queue(nil, TThreadProcedure(LProc));
    tmBackground:
      if (AIsMainThread) then
        {$IF CompilerVersion >= 28.0}
        TTask.Run(LProc, FDebThreadPool)
        {$ELSE}
        TThread.CreateAnonymousThread(LProc).Start
        {$ENDIF}
      else
        LProc();
    tmAsync:
      {$IF CompilerVersion >= 28.0}
      TTask.Run(LProc, FDebThreadPool);
      {$ELSE}
      TThread.CreateAnonymousThread(LProc).Start;
      {$ENDIF}
  else
    raise EUnknownThreadMode.CreateFmt('Unknown thread mode: %s.', [Ord(ASubscription.SubscriberMethod.ThreadMode)]);
  end;
end;

procedure TNiuEventBus.PostToSubscription(ASubscription: IDEBSubscription; const AEvent: IInterface; AIsMainThread: Boolean);
var
  LProc: TProc;
begin
  if not Assigned(ASubscription.Subscriber) then
    Exit;

  LProc := procedure begin
     InvokeSubscriber(ASubscription, [AEvent as TObject]);
  end;

  case ASubscription.SubscriberMethod.ThreadMode of
    tmPosting:
      LProc();
    tmMainThread:
      if (AIsMainThread) then
        LProc()
      else
        TThread.Queue(nil, TThreadProcedure(LProc));
    tmBackground:
      if (AIsMainThread) then
        {$IF CompilerVersion >= 28.0}
        TTask.Run(LProc, FDebThreadPool)
        {$ELSE}
        TThread.CreateAnonymousThread(LProc).Start
        {$ENDIF}
      else
        LProc();
    tmAsync:
      {$IF CompilerVersion >= 28.0}
      TTask.Run(LProc, FDebThreadPool);
      {$ELSE}
      TThread.CreateAnonymousThread(LProc)).Start;
      {$ENDIF}
  else
    raise Exception.Create('Unknown thread mode');
  end;
end;


{ TNiuEventBusFactory }
class constructor TNiuEventBusFactory.Create;
begin
  FEventBus := CreateEventBus();
end;

class destructor TNiuEventBusFactory.Destroy;
begin
  FEventBus := nil;
end;

class function TNiuEventBusFactory.CreateEventBus: INiuEventBus;
begin
  Result := TNiuEventBus.Create;
end;

class function TNiuEventBusFactory.GetInstance: INiuEventBus;
begin
  Result := FEventBus;
end;

end.
